home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / dial.tcl < prev    next >
Text File  |  1997-03-26  |  4KB  |  157 lines
  1. # (nowrap)
  2. set menuFlags(defaultFont)        "system monaco courier geneva helvetica times {new york}"
  3. set menuFlags(printerFont)        "system monaco courier geneva helvetica times {new york}"
  4. set menuFlags(printerFontSize)    "9 10 12 14 18"
  5. set menuFlags(fontSize)            "9 10 12 14 18"
  6. set menuFlags(savedState)        "none think mpw"
  7.  
  8.             
  9. proc suffixMappings {} {
  10.     global filepats
  11.     
  12.     set l1 5
  13.     set w1 35
  14.     set l2 [expr $l1 + $w1 + 5]
  15.     set w2 200
  16.     set h 18
  17.     set top 5
  18.     set mar 5
  19.  
  20.     set modes [lsort -ignore [array names filepats]]
  21.     set len [expr [llength $modes] + 1]
  22.     set modes1 [lrange $modes 0 [expr $len/2 - 1]]
  23.     set modes2 [lrange $modes [expr $len/2] end]
  24.     
  25.     foreach m $modes1 {
  26.         lappend items -t $m $l1 $top [expr $l1 + $w1] [expr $top + $h]
  27.         lappend items -e $filepats($m) $l2 $top [expr $l2 + $w2] [expr $top + $h - 2]
  28.         incr top [expr $h + $mar]
  29.     }
  30.  
  31.     set top2 5
  32.     set l1 [expr $l2 + $w2 + 20]
  33.     set l2 [expr $l1 + $w1 + 5]
  34.     foreach m $modes2 {
  35.         lappend items -t $m $l1 $top2 [expr $l1 + $w1] [expr $top2 + $h]
  36.         lappend items -e $filepats($m) $l2 $top2 [expr $l2 + $w2] [expr $top2 + $h - 2]
  37.         incr top2 [expr $h + $mar]
  38.     }
  39.     
  40.     if {$top2 > $top} {
  41.         set top $top2
  42.     }
  43.     incr top $mar
  44.     
  45.     set l1 5
  46.     lappend buts -b OK $l1 $top [expr $l1 + 60] [expr $top + 20]
  47.     lappend buts -b Cancel [expr $l1 + 100] $top [expr $l1 + 160] [expr $top + 20]
  48.     
  49.     set res [eval "dialog -w [expr $l2 + $w2 + 10] -h [expr $top + 27]" $buts $items]
  50.     
  51.     if {[car $res]} {
  52.         set res [cddr $res]
  53.  
  54.         foreach m [lsort -ignore [array names filepats]] {
  55.             if {$filepats($m) != [car $res]} {
  56.                 lappend changed [list $m [car $res]]
  57.             }
  58.             set res [cdr $res]
  59.         }
  60.  
  61.         foreach pair $changed {
  62.             addArrDef filepats [car $pair] [cadr $pair]
  63.             set filepats([car $pair]) [cadr $pair]
  64.         }
  65.     }
  66.     updateSuffixes
  67. }
  68. bind f12 suffixDialog
  69.  
  70. proc modeDialog {flags vars {title ""}} {
  71.     global maxT
  72.     set left 20
  73.     set maxT 0
  74.     set args [dialSet $flags $vars 20 10 $title]
  75.     set height [expr $maxT + 30]
  76.     set buttons [concat -b OK $left [expr $height-30] [expr $left + 60] [expr $height-10] -b Cancel [expr $left + 100] [expr $height-30] [expr $left + 160] [expr $height-10]]
  77.     set res [eval [concat dialog -w 480 -h $height $buttons $args]] 
  78.     if {[lindex $res 0]} {
  79.         return [lrange $res 2 end]
  80.     } else {
  81.         error "Cancel chosen"
  82.     }
  83. }
  84.  
  85. proc dialSet {flags vars {left 20} {top 40} {title ""}} {
  86.     global maxT menuFlags
  87.     
  88.     set t $top
  89.     if {$title != ""} {
  90.         lappend args "-t" $title 30 10 400 25
  91.         incr top 25
  92.     }
  93.     # if variable names are very long, switch to 2 columns
  94.     if {[maxListItemLength $flags] > 20} {
  95.         set perRow 2
  96.         set width 225
  97.     } else {
  98.         set perRow 3
  99.         set width 150
  100.     }
  101.     set height    15
  102.     
  103.     set ind 0 
  104.  
  105.     foreach f $flags {
  106.         global $f
  107.         set l [expr $left + ($ind % $perRow) * $width]
  108.         set t [expr $top + ($ind / $perRow) * $height]
  109.         lappend args "-c" $f [set $f] $l $t [expr $l + $width] [expr $t + $height]
  110.         incr ind
  111.     }
  112.     
  113.     if {$ind} {
  114.         set top [expr $t + 40]
  115.         lappend args -p 100 [expr $t + 27] 300 [expr $t + 28]
  116.     } 
  117.     
  118.     set perRow    1
  119.     set width    400
  120.     set height    17
  121.     
  122.     set inc [expr $height + 10]
  123.     if {[maxListItemLength $vars] > 20} {
  124.         set lf 155
  125.     } else {
  126.         set lf 135
  127.     }
  128.     
  129.     set ind 0 
  130.     foreach v $vars {
  131.         global $v
  132.         set l [expr $left + ($ind % $perRow) * $width]
  133.         set t [expr $top + ($ind / $perRow) * $inc]
  134.         lappend args "-t" "$v:" $l $t [expr $l + $lf] [expr $t + $height]
  135.  
  136.         if {[string match "*Color" $v]} {
  137.             lappend args "-m" [concat [list [set $v]] {none blue cyan green magenta red white yellow}] [expr $l + $lf -2] $t [expr $l + $width - 14] [expr $t + $height +1]
  138.         } elseif {[info exists menuFlags($v)]} {
  139.             lappend args "-m" [concat [list [set $v]] $menuFlags($v)] [expr $l + $lf -2] $t [expr $l + $width - 14] [expr $t + $height +1]
  140.         } else {
  141.             lappend args "-e" [set $v] [expr $l + $lf] $t [expr $l + $width - 10] [expr $t + $height +1]
  142.         }
  143.         incr ind
  144.     }
  145.  
  146.     incr t 30
  147.     if {$t > $maxT} {set maxT $t}
  148.     return $args
  149. }
  150.  
  151. proc maxListItemLength {l} {
  152.     regsub -all {\w} $l {A} l
  153.     return [string length [lindex [lsort -decreasing $l] 0]]
  154. }
  155.  
  156.  
  157.